home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / CallBack / SCROLBAR.CLS < prev    next >
Text File  |  1997-06-09  |  3KB  |  116 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ScrollBar"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. DefLng H
  12.  
  13. Public SB_TYPE As Integer 'SB_HORZ or SB_VERT
  14. Private m_SmallChange As Integer
  15. Private m_LargeChange As Integer
  16. Public hm_hWnd
  17. Private hm_Min
  18. Private hm_Max
  19.  
  20. Public Function Change(wParam As Long) As Integer
  21. Dim iChange As Integer
  22. Dim lOldPos As Long
  23. Dim lNewPos As Long
  24.     lOldPos = GetScrollPos(hm_hWnd, SB_TYPE)
  25.     Select Case wParam And &HFFFF&
  26.         Case SB_LINEUP: iChange = -m_SmallChange
  27.         Case SB_LINEDOWN: iChange = m_SmallChange
  28.         Case SB_PAGEUP: iChange = -m_LargeChange
  29.         Case SB_PAGEDOWN: iChange = m_LargeChange
  30.         Case SB_THUMBTRACK, SB_THUMBPOSITION:
  31.             iChange = wParam \ &H10000 - lOldPos
  32.         Case Else
  33.             Exit Function
  34.     End Select
  35.     If iChange Then
  36.         lNewPos = lOldPos + iChange
  37.         If lNewPos < hm_Min Then lNewPos = hm_Min
  38.         If lNewPos > hm_Max Then lNewPos = hm_Max
  39.         iChange = lOldPos - lNewPos
  40.         If iChange Then SetScrollPos hm_hWnd, SB_TYPE, lNewPos, 1
  41.     End If
  42.     Change = iChange
  43. End Function
  44.  
  45. Public Property Let Value(NewValue As Integer)
  46.     SetScrollPos hm_hWnd, SB_TYPE, NewValue, 1
  47. End Property
  48.  
  49. Public Property Get Value() As Integer
  50.     Value = GetScrollPos(hm_hWnd, SB_TYPE)
  51. End Property
  52.  
  53. Public Property Let hWnd(Handle As Long)
  54.     hm_hWnd = Handle
  55.     If hm_hWnd Then
  56.         GetScrollRange hm_hWnd, SB_TYPE, hm_Min, hm_Max
  57.     End If
  58. End Property
  59.  
  60. Public Property Get hWnd() As Long
  61.     hWnd = hm_hWnd
  62. End Property
  63.  
  64. Public Property Let SmallChange(Value As Integer)
  65.     '>32767 taken care of by integer type
  66.     If Value < 1 Then Err.Raise 380 'Invalid property value.
  67.     m_SmallChange = Value
  68. End Property
  69.  
  70. Public Property Get SmallChange() As Integer
  71.     SmallChange = m_SmallChange
  72. End Property
  73.  
  74. Public Property Let LargeChange(Value As Integer)
  75.     '>32767 taken care of by integer type
  76.     If Value < 1 Then Err.Raise 380 'Invalid property value.
  77.     m_LargeChange = Value
  78. End Property
  79.  
  80. Public Property Get LargeChange() As Integer
  81.     LargeChange = m_LargeChange
  82. End Property
  83.  
  84. Public Property Let Max(Value As Integer)
  85. Dim lValue As Long
  86.     '>32767 taken care of by integer type
  87.     If Value < 0 Then Err.Raise 380 'Invalid property value.
  88.     lValue = Value
  89.     SetScrollRange hm_hWnd, SB_TYPE, hm_Min, lValue, 1
  90.     hm_Max = Value
  91. End Property
  92.  
  93. Public Property Get Max() As Integer
  94.     Max = hm_Max
  95. End Property
  96.  
  97. Public Property Let Min(Value As Integer)
  98. Dim lValue As Long
  99.     '>32767 taken care of by integer type
  100.     If Value < 0 Then Err.Raise 380 'Invalid property value.
  101.     lValue = Value
  102.     SetScrollRange hm_hWnd, SB_TYPE, lValue, hm_Max, 1
  103.     hm_Min = Value
  104. End Property
  105.  
  106. Public Property Get Min() As Integer
  107.     Min = hm_Min
  108. End Property
  109.  
  110. Private Sub Class_Initialize()
  111.     m_SmallChange = 1
  112.     m_LargeChange = 1
  113.     hm_Min = 0
  114.     hm_Max = 100
  115. End Sub
  116.